Otherware/Otherware_1_SB_Development.iso/mac/util/comm/muucp43.sit/Mac_gnuucp/MailReader 4.3/stack.txt

Text File | 1991-01-28 | 17.1 KB | 601 lines

-- stack: in.3
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 1
-- first background id: 4178
-- card count: 7
-- first card id: 3794
-- list block id: 4821
-- print block id: 3581
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 49024 bytes
-- stack block size: 16896 bytes
-- created by hypercard version: 0x01228000
-- compacted by hypercard version: 0x01258000
-- modified by hypercard version: 0x01258000
-- opened by hypercard version: 0x01258000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x0000220000002200
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0xCC003300CC003300
-- patterns[4]: 0xCC883300CC883322
-- patterns[5]: 0xEE88BB22EE88BB22
-- patterns[6]: 0xEECCBB33EECCBB33
-- patterns[7]: 0xFFCCFF33FFCCFF33
-- patterns[8]: 0xFFEEFFBBFFEEFFBB
-- patterns[9]: 0xFFFFFFBBFFFFFFBB
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x112244889126B02D
-- patterns[14]: 0xA4907AFC0D0A4E4F
-- patterns[15]: 0x2043415252494552
-- patterns[16]: 0x0D0AAA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
-- These XCMDs and XFCNs are included in this stack.

-- Files by Guy de Picciotto freeware
-- CIS: 73300,3637
-- GENIE: G.PICCIOTO
--
-- DoList Copyright ©1987 By James L. Paul
-- Non-commercial use only!
-- Compuserve 72767,3436
-- GEnie J.Paul
--
-- fileName by Steve Maller
-- Non-commercial use only!

on openStack
  global ReadingMail
  set userlevel to 5
  if the version < "1.2" then
    Answer "This stack requires Hypercard 1.2 or newer..." with "Drat!"
    go home
  end if
  hide message box
  show menubar
  set the textfont of cd fld summary of cd 1 to Helvetica
  set the textsize of cd fld summary of cd 1 to 12
  put true into ReadingMail
  getAlias
  if line 1 of (cd fld TImeZone of cd Config) is empty then
    get quote
    repeat until number of chars of it is 3 or it is empty
      Ask "Please enter your Time Zone..." with "EST"
    end repeat
    repeat with i=1 to 3
      put chartonum(char i of it) into arg
      if arg<123 and arg>96 then
        put numtochar(arg-32) into char i of it
      end if
    end repeat
    if it is not empty then put it into cd fld TimeZone of cd config
  end if
end openStack

on getAlias
  global aliasLIst
  put line 1 of (cd fld SpoolFolder of cd config) &":"&"Alias" into pref
  put Files(pref,"TEXT") into temp
  repeat with i=1 to number of lines of temp
    put line i of temp into item i of aliasList
  end repeat
end getAlias

on makeSummary
  set cursor to busy
  set lockscreen to true
  set lockmessages to true
  go third cd
  put 1 into i
  put empty into cd fld summary of first cd
  get (number of cds ) -7
  repeat until short name of this cd Γëá "Mail"
    put char 1 to 35 of line 1 of fld "From" && "--" && char 1 to 35 of line 1 of fld "Subject" into line i of cd fld Summary of first cd
    add 1 to i
    go next cd
  end repeat
  go first cd
  put it into cd fld TotalMsgs of cd "GetNewMail"
  redMsg
  set lockmessages to false
  set lockscreen to false
end makeSummary

on RedMsg
  put (number of cds ) -7 into j
  put 3 into i
  repeat until (short name of cd i) Γëá "Mail"
    if hilite of btn red of cd i then subtract 1 from j
    add 1 to i
  end repeat
  go first cd
  put j into line 2 of cd fld TotalMsgs of cd "GetNewMail"
end redMsg

on scrfld fname,arg
  if number of lines of cd fld fname > arg then
    set style of cd fld fname to scrolling
  else
    set style of cd fld fname to rectangle
  end if
end scrfld

function CheckNewMail
global MailExists
put makeMailFileName() into tmpname
put "* " into mscan
get (cd fld SpoolFolder of cd config) &":Mail:"
if (cd fld MailScan of cd Config is not empty) then
  repeat with i=1 to number of lines of cd fld MailScan of cd Config
    put first word of line i of cd fld MailScan of cd Config into fn
    if fileExists(it&fn) = 1 then
      put fn & space after mscan
    end if
  end repeat
end if
put "*" after mscan
if mscan is "* *" then put empty into mscan
if fileExists(tmpname) = "1" or mscan is not empty then
  put "You Have New Mail"&& mscan into cd fld "notes" of cd "GetNewMail"
  if hilite of btn "Sound On" of cd "Config" then play mail
  put 1 into MailExists
else
  put "No New Mail" into cd fld "notes" of cd "GetNewMail"
  put 0 into MailExists
end if
end CheckNewMail

function makeMailFileName
return (cd fld "SpoolFolder" of Cd "Config") & ":Mail:" & (Cd Fld "UserName" of Cd "Config")
end makeMailFileName

function isNewMail
global MailError
put makeMailFileName() into MailFile
put Mailfile & random(1000000) into NewMailName
if fileExists (Mailfile) = "1" then
  put fileRename (Mailfile, NewMailName) into MailError
  return NewMailName
else
  return empty
end if
end isNewMail

function insertBody
global to,from,subject,date,body
if the length of body < cd fld Msgsize of cd config then
  put body into cd fld "body"
else
  put StackDir() & ":Body." & the id of this cd into filename
  put "Body of message too large for Hypercard," & return & "stored in: " & filename & "." into cd fld "body"
  open file filename
  write body to file filename
  close file filename
end if
return 0
end insertBody

function getTheNewMail
global MailError
put isNewMail() into NewMail
put NewMail into cd fld Notes
if NewMail is not empty then
  put readNewMail(NewMail) into MailError
  put fileDelete(NewMail) into MailError
end if
return 0
end getTheNewMail

function readNewMail fileName
global MailExists,MailCheckTime,to,from,replyto,subject,date,body
global TotalMailMessages,ReadingMail
put the id of cd "GetNewMail" into NewMailCard
open file fileName
repeat while ReadaMessage (fileName)
  set LockScreen to true
  set LockMessages to true
  put false into ReadingMail
  put the id of this cd into OldCardID
  go cd MailMsgTemplate
  domenu "Copy Card"
  domenu "Paste Card"
  set name of this cd to "Mail"
  put the id of this cd into NewcardID
  go cd "GetNewMail"
  go NewCardID
  put to into cd fld "to"
  put from into fld "from"
  put subject into fld "subject"
  put date into cd fld "date"
  put replyto into cd fld "ReplyTo"
  put insertBody() into MailError
  set cantDelete of NewcardID to false
  set hilite of cd btn red to false
  go cd "GetNewMail"
  put true into ReadingMail
  set lockmessages to false
  set LockScreen to false
  makeSummary
end repeat
close file fileName
put 0 into MailExists
put 0 into MailCheckTime
return 0
end ReadNewMail

function ReadaMessage name
global from,to,replyto,date,subject,body,allDone
put empty into from
put empty into to
put empty into date
put empty into subject
put empty into body
put empty into replyto
put false into Alldone
put false into foundOne
repeat while not allDone
  Read from file name until return
  set cursor to busy
  if it is return or it is empty then
    put true into allDone
  else if word 1 of it is "From:" then
    put doFrom (it) into MailError
  else if word 1 of it is "Reply-To:" then
    put doReplyTo (it) into MailError
  else if word 1 of it is "To:" then
    put doTo (it) into MailError
  else if word 1 of it is "Date:" then
    put doDate (it) into MailError
  else if word 1 of it is "Subject:" then
    put doSubject (it) into MailError
  else
    put it after body
  end if
  put it into cd fld notes of cd "GetNewMail"
end repeat
put return after body
put false into allDone
repeat while not allDone
  read from file name until return
  set cursor to busy
  if it is empty then
    put true into allDone
  else if it contains numToChar(255) then
    put true into alldone
    put true into FoundOne
  else
    put it after body
  end if
end repeat
if foundone is true then
  put "Processed body of message" into cd fld notes of cd "GetNewMail"
end if
return foundone
end ReadaMessage

-- Optimization by Ned Horvath
-- [e-mail] 1/27/90
-- Cannot be used now besacuse of a bug in system 7.0
-- Should be checked in release version of 7.0
--function readNewMail fileName
--  global MailExists,MailCheckTime,to,from,replyto,subject,date,body
--  global TotalMailMessages,ReadingMail
--  global MailData -- ECH
--  put the id of cd "GetNewMail" into NewMailCard
--  open file fileName
-- ECH -- read...until fails -50 on HC2.0, Sys7.0b1
-- ECH -- so we read all data into MailData for later reading
-- ECH -- by ReadaMessage
--  put "" into MailData
--  repeat forever
--    read from file fileName for 16384
--    if it is empty then exit repeat
--    put it after MailData
--  end repeat
--  close file fileName -- ECH this command was after the next repeat loop.
-- ECH -- end of inserted code
--  repeat while MailData is not empty
--    if not ReadaMessage () then exit repeat
--    set LockScreen to true
--    set LockMessages to true
--    put false into ReadingMail
--    put the id of this cd into OldCardID
--    go cd MailMsgTemplate
--    domenu "Copy Card"
--    domenu "Paste Card"
--    set name of this cd to "Mail"
--    put the id of this cd into NewcardID
--    go cd "GetNewMail"
--    go NewCardID
--    put to into cd fld "to"
--    put from into fld "from"
--    put subject into fld "subject"
--    put date into cd fld "date"
--    put replyto into cd fld "ReplyTo"
--    put insertBody() into MailError
--    set cantDelete of NewcardID to false
--    set hilite of cd btn red to false
--    go cd "GetNewMail"
--    put true into ReadingMail
--    set lockmessages to false
--    set LockScreen to false
--    makeSummary
--  end repeat
-- ECH -- next statement moved to before loop
-- ECH close file fileName
--  put 0 into MailExists
--  put 0 into MailCheckTime
--  return 0
--end ReadNewMail

--function ReadaMessage -- ECH name
-- ECH name argument removed: data now in global MailData
--  global from,to,replyto,date,subject,body,allDone
--  global MailData -- ECH
--  put empty into from
--  put empty into to
--  put empty into date
--  put empty into subject
--  put empty into body
--  put empty into replyto
--  put false into Alldone
--  put false into foundOne
--  repeat while not allDone
-- ECH -- used to be: Read from file name until return
--    put (line 1 of MailData) & return into it
--    delete line 1 of MailData
-- ECH
--    set cursor to busy
--    if it is return or it is empty then
--      put true into allDone
--    else if word 1 of it is "From:" then
--      put doFrom (it) into MailError
--    else if word 1 of it is "Reply-To:" then
--      put doReplyTo (it) into MailError
--    else if word 1 of it is "To:" then
--      put doTo (it) into MailError
--    else if word 1 of it is "Date:" then
--      put doDate (it) into MailError
--    else if word 1 of it is "Subject:" then
--      put doSubject (it) into MailError
--    else
--      put it after body
--    end if
--    put it into cd fld notes of cd "GetNewMail"
--  end repeat
--  put return after body
--  put false into allDone
--  repeat while not allDone
-- ECH -- Used to be: Read from file name until return
--    put (line 1 of MailData) & return into it
--    delete line 1 of MailData
-- ECH
--    set cursor to busy
--    if it is empty then
--      put true into allDone
--    else if it contains numToChar(255) then
--      put true into alldone
--      put true into FoundOne
--    else
--      put it after body
--    end if
--  end repeat
--  if foundone is true then
--    put "Processed body of message" into cd fld notes --    of cd "GetNewMail"
--  end if
--  return foundone
--end ReadaMessage

function doTo arg
global to
put arg into to
end doTo

function doReplyTo arg
global replyto
put arg into replyto
end doReplyTo

function doFrom arg
global from
put arg into from
end doFrom

function doDate arg
global date
put arg into date
end doDate

function doSubject arg
global subject
put arg into subject
end doSubject

function stripBrackets arg
put arg into tmp
if char 1 of tmp is "<" then
  delete char 1 of tmp
end if
if last char of tmp is ">" then
  delete last char of tmp
end if
return tmp
end stripBrackets

function stripBlanks arg
put arg into tmp
repeat while (char 1 of tmp is space or char 1 of tmp is return)
  delete char 1 of tmp
end repeat
repeat while (last char of tmp is space or last char of tmp is return)
  delete last char of tmp
end repeat
return tmp
end stripBlanks

function StackDir
put the long name of this stack into tmpName
repeat while last character of tmpName <> ":"
  delete last character of tmpName
end repeat
put 0 into i
delete last character of tmpName
repeat while i < 7
  delete first character of tmpName
  add 1 to i
end repeat
return tmpName
end StackDir

function SendTo name
-- a speedier version that writes everything to a variable
-- then writes it all in one go to a file (also shorter)
-- for comma, delimited names, the long stuff is only done once.
global wrbody,multiple
put (cd fld "SpoolFolder" of cd config) & ":Spool:" & "Tmp." & (cd fld "UserName" of cd config) into msgname
put MakeTmpFileName(msgname) into msgname
put "From " into myMail
put (cd fld UserName of cd "Config") & " remote from " after myMail
put (cd fld MachineName of cd "Config") after myMail
put return after myMail
put "To: " & stripblanks(cd fld "To") &return after myMail
if cd fld "Cc" is not empty then put "Cc: " & stripblanks(cd fld "Cc") &return after myMail
put "From: " & stripblanks(cd fld "From") &return after myMail
put "Organization: " & stripblanks((cd fld "OrganizationName" of cd config)) & return after myMail
put "Reply-To: " & stripblanks((cd fld "ReplyAddress" of cd config)) &return after myMail
put "Date: " & stripblanks(cd fld "Date") & return after myMail
put "Subject: " & stripblanks(cd fld "Subject") &return &return after myMail
if not multiple or (multiple and wrbody is empty) then put WriteJustified(msgname,card field "Body",70) into wrbody
put wrbody & return after myMail
open file msgname
write myMail to file msgname
close file msgname
put (cd fld "SpoolFolder" of cd config) & ":Spool:" & "Rmail." & (cd fld "UserName" of cd config) into temp
put MakeTmpFileName(temp) into temp
Open file temp
write msgname &return &name &return to file temp
Close file temp
end Sendto

function copyFile fromFile, toFile
put false into allDone
repeat until allDone
  Read from file fromFile until return
  if it is empty then
    put true into allDone
  else write it to file toFile
end repeat
return 0
end copyFile

function MakeTmpFileName firstPart
repeat while true
  put firstPart & random(100000) into tname
  if fileExists(tname) is 0 then
    return(tname)
  end if
end repeat
end MakeTMpFileName

function WriteJustified fileName, String, width
put empty into wrbody
put String into tmpStr
put return after tmpstr
if hilite of btn "Add Line Wrap" of cd config then
  repeat until (tmpStr is empty)
    set cursor to busy
    put false into writeReturn
    put the number of chars of tmpStr into strLen
    put offset(return, tmpStr) into lineLen
    if (lineLen = 0) then put strLen into lineLen
    if (lineLen >= width) then put width into lineLen
    if (lineLen <= width) and (lineLen < strLen) then put true into writeReturn
    if (lineLen > strLen) then put strLen into lineLen
    repeat
      if char lineLen of tmpStr is space or char lineLen of tmpStr is return or linelen=0 then
        exit repeat
      end if
      subtract 1 from lineLen
    end repeat
    put char 1 to lineLen of tmpStr into currLine
    delete char 1 to lineLen of tmpStr
    if (last char of currline = return) then delete last char of currline
    put currline after wrbody
    if (writeReturn = true) then put return after wrbody
  end repeat
else
  put tmpstr into wrbody
end if
return wrbody
end WriteJustified

function GetAddressee address
global begin, endd, ans
put address into ans
if word 1 of ans is "From:" then
  delete word 1 of ans
end if
if word 1 of ans is "Reply-To:" then
  delete word 1 of ans
end if
put offset("<", ans) into begin
put offset(">", ans) into endd
if ((begin Γëá 0) and (endd Γëá 0) and (endd > begin)) then
  put char begin+1 to endd-1 of ans into ans
  put stripBlanks(ans) into ans
  return (ans)
end if
put offset("(", ans) into begin
put offset(")", ans) into endd
if ((begin Γëá 0) and (endd Γëá 0) and (endd > begin)) then
  delete char begin to endd of ans
end if
put stripBlanks(ans) into ans
return (ans)
end GetAddressee

function outfilename
put "Mail Output" into defaultName
put StandardFile("put", defaultName) into SDFileout
if SDFileout is empty then
  return empty
end if
return(SDFileout)
end outfilename